perm filename MSFILL.F4[Y,MUS] blob sn#068306 filedate 1973-12-01 generic text, type T, neo UTF8
00100		SUBROUTINE FILLER(IFILL,QJB,QCENT,BX,BY)
00300		DIMENSION IFILL(1)
00400		COMMON /DL/IXRX,SAVER,NAME
00500		COMMON /SIZ/RSZ,JCEN,KCEN
00700		COMMON /FL/IC,N,NQ,RZ,XGP
00800		COMMON /STF/RSTFAC(8),RSTJC
00900		COMMON /PLTR/IPLT,RHT,DIS
01000		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
01200		EQUIVALENCE (RXGP,WDS(250))
01300		DATA RC/1./
01400		PX=1
01420		IF(BX.EQ.0)BX=1
01440		IF(BY.EQ.0)BY=1
01470		IF(BX)PX=-1
01500		IXGP=XGP
01600		RSI=RSTJC*BY
01700	C  RI IS INVERSION FACTOR
01830		BZ=BY/BX
01840		RT=RSTJC*BX
01860	C  RS=HORIZ.    RT=VERT.
01900		JXGP=RXGP
02000		NX=2
02100	C  NX IS POINTER IN X ARRAY
02200		ID=IFILL(NX)
02400		IF(IPLT)GO TO 101
02500		RBZ=QJB*RSZ
02600		RXX=RSZ*RT
02620	C  WHAT ABOUT RXX???????? 
02700		RYX=QCENT*RSZ
02800		RXY=RSI*RSZ
02900		GO TO 100
03000	101	RXX=RT*DIS
03100		RXY=RSI*RHT
03200		RBZ=QJB*DIS
03300		RYX=QCENT*RHT
03400	100	RM=-1000
03450		IF(PX)RM=-RM
03500		I=NX+1
03600	103	CALL UNPACK(IA,IB,IFILL(I))
03700		IF(IA.NE.IFILL(I+1)/10000)GO TO 102
03800		I=I+1
03900		GO TO 103
04000	102	G=IA*RT+QJB
04100		H=IB*RSI+QCENT
04200		IF(IPLT)GO TO 200
04300		CALL LINES(G,H,3)
04400		GO TO 300
04500	200	IF(IXRX.EQ.0)GO TO 90
04600		M=ROFF(-H*RHT+RXGP)
04700		N=ROFF(G*DIS+XGP)
04800		GO TO 80
04900	90	M=ROFF(G*DIS)
05000		N=ROFF(H*RHT)
05100	80	CALL PLOT(M,N,3)
05200	300	NN=ID-1
05300	C  LAST OF ARRAY-1
05400		P=IA*RXX
05500		CALL UNPACK(IG,H,IFILL(I+1))
05600		RB=IG*RXX+PX
05700		J=1
05800	1	JJ=1
05850		IF(PX)GO TO 30
05900		IF(RM.GT.RB)GO TO 13
05950		GO TO 31
05960	30	IF(RM.LT.RB)GO TO 13
06000	31	IF(J)GO TO 2
06100	3	CALL NNN(NN,1,0,IFILL)
06200	C  FINDS BOTTOM POINTER
06300		GO TO 16	
06400	2	CALL NNN(I,0,1,IFILL)
06500	C  FINDS TOP POINTER(I)
06600	16	CALL UNPACK(JAX,JB,IFILL(N))
06700		CALL UNPACK(JG,JH,IFILL(N+1))
06800		CALL UNPACK(IQ,H,IFILL(NQ))
06900		RZ=RZ*RXX
06905	10	RDIS=JAX-JG
06910		IF(PX)GO TO 32
07000		IF(P.GT.RZ)P=RZ
07010		GO TO 33
07020	32	IF(P.LT.RZ)P=RZ
07095	C  REVERSES VERT.
07100	33	Q=IQ*RXX
07200		C=IC*RXY+RYX
07400		IF(RDIS.NE.0)GO TO 6
07500	C  FOR STRAIIGHT UP-DOWN LINES
07600		IF(NN-1.EQ.I)GO TO 13
07700		P=P-PX
07800		GO TO 5
07900	6	H=BZ*(JB-JH)/RDIS
08000	11	HH=(P-Q)*H+C
08100		PP=P+RBZ
08200		IH=ROFF(HH)
08300		IP=ROFF(PP)
08400	C  ROFF IS FOR ROUND-OFF ERRORS
08500		IF(IP.EQ.MP.AND.IH.EQ.MH)GO TO 180
08600		MP=IP
08700		MH=IH
08800	C  OMITS REPEATED POINTS
08900		IF(IPLT)GO TO 17
09000	CC	IF(RSZ.LE.0.8571)GO TO 34
09100	CC	IP=IP-JCEN
09200	CC	IH=IH-KCEN
09300	CC34	CALL AVECT(IP,IH)
09350		CALL LINES(PP/RSZ,HH/RSZ,2)
09400		GO TO 180
09500	17	IF(IXRX.EQ.0)GO TO 19
09600		K=IP
09700		IP=-IH+JXGP
09800	C NO RNDOFF OR DIS-RHT FACTORS HERE YET.
09900		IH=K+IXGP
10000	19	CALL PLOT(IP,IH,2)
10100	180	JJ=JJ-1
10200		IF(JJ)GO TO 12
10300		RM=P
10400		P=P+PX
10410		IF(PX)GO TO 35
10500		IF(P.LT.RZ)GO TO 11
10510		GO TO 5
10520	35	IF(P.GT.RZ)GO TO 11
10600	5	IF(J)GO TO 4
10700		NN=NN-1
10800		IF(I.GT.NN)GO TO 13
10920		GO TO 3
11000	4	I=I+1
11100		IF(I.GT.NN)GO TO 13
11200	402	CALL UNPACK(IA,IB,IFILL(I+1))
11300		RB=IA*RXX+PX
11400		GO TO 2
11500	12	J=-J
11600		GO TO 1
11700	13	NX=ID+1
11800		IF(ID.EQ.IFILL(1))GO TO 130
11900		ID=IFILL(NX)
12000		GO TO 100
12200	130	MP=1000
12300		MH=1000
12400		RETURN
12500		END
12600	
12700		SUBROUTINE NNN(J,L,K,IFILL)
12800		COMMON /FL/IC,N,NQ,RZ,XGP
12900		DIMENSION IFILL(1)
13000		CALL UNPACK(IZ,IC,IFILL(J+K))
13100		CALL UNPACK(N,IC,IFILL(J+L))
13200		N=J
13300	C  C IS THE CONSTANT
13400		NQ=N+L
13500		RZ=IZ
13600		RETURN
13700		END
13800	
13900		SUBROUTINE UNPACK(M,N,I)
14000		COMMON/LL/L
14100	C  L IS FOR VIS. OR INVIS. LINES.
14200		N=I
14300		L=2
14400		IF(N.LT.100000000)GO TO 2
14500		L=3
14600		N=N-100000000
14700	2	M=N/10000
14800		N=N-M*10000
14900		IF(M.GT.1000)M=1000-M
15000		IF(N.GT.1000)N=1000-N
15100		RETURN
15200		END
15300	
15400		FUNCTION ROFF(R)
15500		S=.5
15600		IF(R)S=-S
15700		ROFF=R+S
15800		RETURN
15900		END